home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Suzy B Software 2
/
Suzy B Software CD-ROM 2 (1994).iso
/
extras
/
boot_up
/
deskdrop
/
dskdrp12.lst
< prev
next >
Wrap
File List
|
1995-04-27
|
3KB
|
162 lines
' DeskDrop Version 1.2
' by Walter S. Wilson, 02 January 1995
' in GFA 3.5e
'
fsource$=CHAR{BASEPAGE+&H81} ! command line
'
IF fsource$=""
ALERT 1," You haven't read | the manual yet? ",1," Oops! ",b%
GOSUB end_thing
ENDIF
'
RESERVE 110000
GOSUB setup
'
GOSUB get_drive
GOSUB oldfile
GOSUB burt
GOSUB memclear
GOSUB end_thing
' Procedures
> PROCEDURE setup ! MALLOC and buffer sizing
'
adr%=MALLOC(32000)
IF adr%<0
'
ALERT 1," Couldn't allocate | 32k of contiguous | RAM! ",1," Ouch! ",b%
GOSUB memclear
GOSUB end_thing
ENDIF
bsize%=32000
'
RETURN
> PROCEDURE get_drive ! Current drive and destination path
'
drive%=GEMDOS(25)
dr$=CHR$(65+drive%)+":"
'
fdest$=dr$+"\NEWDESK.INF"
'
RETURN
> PROCEDURE drivespace ! Check free space on destination disk
'
appl$=LEFT$(fdest$,1)
'
IF appl$="A"
ap%=1
ELSE IF appl$="B"
ap%=2
ELSE IF appl$="C"
ap%=3
ELSE IF appl$="D"
ap%=4
ELSE IF appl$="E"
ap%=5
ELSE IF appl$="F"
ap%=6
ELSE IF appl$="G"
ap%=7
ELSE IF appl$="H"
ap%=8
ELSE IF appl$="I"
ap%=9
ELSE IF appl$="J"
ap%=10
ELSE IF appl$="K"
ap%=11
ELSE IF appl$="L"
ap%=12
ELSE IF appl$="M"
ap%=13
ELSE IF appl$="N"
ap%=14
ELSE IF appl$="O"
ap%=15
ELSE IF appl$="P"
ap%=16
ENDIF
'
space%=DFREE(ap%)
'
dr$=appl$+":\"
'
RETURN
'
PROCEDURE oldfile ! File copy procedures
'
IF EXIST(fsource$)=TRUE
OPEN "i",#26,fsource$
'
IF EXIST(fdest$)=TRUE
KILL fdest$
ENDIF
'
IF EXIST(fdest$)=FALSE
OPEN "o",#16,fdest$
ENDIF
'
GOSUB drivespace
'
sour%=LOF(#26)
IF sour%<space%
IF sour%>0
REPEAT
IF sour%<bsize%
BGET #26,adr%,sour%
BPUT #16,adr%,sour%
sour%=0
ELSE
BGET #26,adr%,bsize%
BPUT #16,adr%,bsize%
SUB sour%,bsize%
ENDIF
UNTIL sour%<=0
ENDIF
ELSE IF sour%>=space%
ALERT 1," No free space | on destination | disk!! ",1," Dag! ",b%
CLOSE #16
CLOSE #26
GOSUB memclear
GOSUB end_thing
ENDIF
'
CLOSE #26
CLOSE #16
ENDIF
'
RETURN
'
> PROCEDURE burt ! To boot, or not to boot
'
ALERT 1," ReBOOT? ",1,"NO!|Ok",a%
IF a%=1
GOSUB memclear
GOSUB end_thing
ELSE IF a%=2
GOSUB memclear
GOSUB reboot
END
ENDIF
'
RETURN
> PROCEDURE reboot ! ReBoot, the procedure
'
SLPOKE &H420,0
SLPOKE &H426,0
SLPOKE &H43A,0
~XBIOS(38,L:LPEEK(4))
'
RETURN
'
> PROCEDURE memclear ! MFREE and unRESERVE
'
y%=MFREE(adr%)
RESERVE
'
RETURN
> PROCEDURE end_thing ! THE END
'
SYSTEM
'
RETURN